perm filename PASS2.SAI[PUB,TES]2 blob sn#131637 filedate 1974-11-19 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00016 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	BEGIN "PUB2"
C00013 00003	SIMPLE PROCEDURE WARN(STRING MESSG) 
C00020 00004	ONE ← 1  COMMENT TO FORCE ARRAY TO BE DYNAMIC 
C00030 00005	BEGIN "INNER BLOCK"
C00034 00006	SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) 
C00039 00007	SIMPLE PROCEDURE SLIDERROR 
C00042 00008	IF PAGEHIGH THEN GO TO CONTINUE  comment, re-entered 
C00046 00009	WHILE (TOPLINE ← INNUM) > -10 DO
C00049 00010	CASE CHARTBL[PAGEBRC] OF
C00052 00011	comment 4 ... CR -- Justify it 
C00057 00012	ELSE	BEGIN CHAR ← 0 MAX APPD(S)
C00064 00013		ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
C00067 00014	comment 5 ... LF  BEGIN END 
C00071 00015	IFC PARCVER THENC PARCDOC ENDC
C00072 00016	BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT  K!OUT END  COMMENT ** ** ** ** ** 
C00077 ENDMK
C⊗;
BEGIN "PUB2"
COMMENT NOTE THAT THE PARCVER USES MEMORY PAGES 700-712 AS A BUFFER ;
REQUIRE "[]<>" DELIMITERS ;
REQUIRE "SITE" SOURCE!FILE;
REQUIRE 6500 STRING!SPACE ;
DEFINE
	PASSONE = [FALSE],
	PASSTWO = [TRUE],
	BEGOF(NAME) = [ ],
	ENDOF(NAME) = [ ],
	PROCEDURES = [ ],
	FINISHED = [ ],
	PUBLIC = [ ],
	PRIVATE = [ ],
	$ = ["],
	# = [],
	IFK = [IFC],
	THENK = [THENC],
	IFSITE = [IFK],
	SITE(DUMMY) = [ ],
	TERNAL = [] ;
REQUIRE "COMMON" SOURCE!FILE ;
COMMENT The Document Compiler -- Pass Two ;
COMMENT Pass One and Two share certain declarations, but in
	one case, the meaning of a variable is different:
		In Pass 1, XCRIBL is true for either
			an XGP -or- PARC's MIC.
		In Pass 2, XCRIBL is only true for an
			XGP.  MICRO is true for PARC's MIC
			and RASTER is true for both.  ;
COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
	Height Width MillLeftMargin MillRightMargin
	For each area:
		UpperLine NumCols NumLines
		For each column:
			LeftChar
			For each non-null line:
				Line Number
				How far short of justification
				Excess mill leading
				Index of Intermediate Ascii File line
			0
	-10

PASS 2 reads the output file name and the intermediate page file names from
        PUPSEQ.PUI,  and  the  label  table from PULABL.PUI.  Then it reads
        each page from each page file, processes each line in each of
        its areas, and writes out a line printer image on the output file.

Each line is subject to three operations, in this order:
	(1) Substitute label values at each vertical tab.
	(2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
	(3) Generate underlining and super/sub-scripting as indicated by rubouts.

		;

IFC CMUVER THENC REQUIRE "PUBTMP.SAI" SOURCE!FILE;
ENDC		COMMENT RKJ: 26-SEP-74;

DEFINE THRU = [STEP 1 UNTIL], DOWN = [STEP -1 UNTIL],
	LH(X) = [(X LSH -18)], RH(X) = [(X LAND '777777)],
	AWHILE = [WHILE TRUE],
	INNUM = [WORDIN(ICHAN)],
	SCN(BRKTBL)= [(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))],
	SCNUM = [CVD(SCN(TO!ALTMODE!SKIP))],
	LPT = [1], TTY = [2], MIC = [3], XGP = [4],
	HORIZ= ['40], VERTI= ['41], CSIZE= ['42], ULINE= ['43], RSPCS= ['44],
	LSPCS= ['45], UDOTS= ['46], RDOTS= ['47], comment FR80 escape codes ;
	FULSTR(X) = [LENGTH(X)], NULSTR(X) = [(LENGTH(X)=0)],
	CR = ['15], LF = ['12], VT = ['13], FF = ['14], SP = ['40],
	RUBOUT = ['177], TB = ['11],
	ALTMODE = IFC TENEX THENC ['33] ELSEC
		  IFC SAILVER THENC ['175] ELSEC ['176] ENDC
		  ENDC,
	TO!ALTMODE!SKIP = [1], TO!LF!APPD = [2],
	ONE!CHAR = [3],	BREAKER = [4], TO!RUB!ALT!SKIP = [5],
	LOCAL!TABLE = [6],
	FIML = [256],
	ANS(A) = [(S = "A" OR S = "A" + '40)];
DEFINE	COMMENT FOR XGP;
	USEA= [('177&'14)],	USEB= [('177&'15)],	VSB= [('177&'20)],
	XTAB= [('177&'30)],
	XGPNUM(N)= [((N LSH -7) & N)];
DEFINE  ESCAPE1= [('177&'1)],	ESCAPE2= [('177&'2)];
DEFINE	CTLK = [11], CTLF= [6], CTLE= [5], CTLT= ['24], CTLQ= ['21];

IFC SAILVER THENC DEFINE RPGEXT = [".RPG"] ; ENDC

PJ 5/28/74 ; DEFINE
	PUIEXT = IFC ITSVER THENC [" PUI"] ELSEC [".PUI"] ENDC,
	OCTEXT = IFC ITSVER THENC [" OCT"] ELSEC [".OCT"] ENDC,
	TXTEXT = IFC ITSVER THENC [" ASC"] ELSEC [".ASC"] ENDC;

TES 1/7/74 ; DEFINE CTLC= [3], CTLH= ['10], CTLR= ['22], CTLU= ['25], CTLS= ['23] ;
EXTERNAL INTEGER !SKIP! ;
INTEGER BRC, EOF ; COMMENT FOR FONTS TES 10/22/74 ;
INTEGER IML, IMC, comment, no. of lines and chars per page image ;
	DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
	LFTMAR, comment RASTER left margin (for tabs) ;
	RGTMAR, comment RASTER right margin ;
	INTRA, comment TES 6/11/74 PARC XGP Intra-line spacing (normally 3) ;
	MILLVERTI, RASTVERTI,  COMMENT TES 11/2/74 "NORMAL" INTERLINE FOR THIS DOC ;
	LISTCHAN, comment output file ;
	BAR, TES underlining character (or 0 if OFF) 10/22/73;
	PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
	I, J, K, L, M, N, DUMMY, comment general-purpose ;
	LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
	NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
	TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
	ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
	TOPLINE, NCOLS, NLINES, comment Area info ;
	COL, LEFTCH, comment Column info ;
	SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
	NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
	NEEDCR, comment, assures CR before every LF for Stanford LPT ;
	LINENO, MLEAD, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
	ONE, comment, 1 ;
	BOTMAR, TOPMAR, RASTPHIGH, RASTPWIDE, RASTLHIGH, comment raster units ;
	LINEY, CURRENTX, CURRENTY, DLBP, DLBP1, FSTFONT,
	TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;

INTEGER  SCRIPT, comment baseline adjustment ;
	THISFONT, comment PARC font number for scripts;
	SCRLVL; comment baseline level ;

INTEGER TLFTMAR ;	TVR temporary left margin in XGP pts;
BOOLEAN MICRO, RASTER ; TES 8/23/74 RASTER = XCRIBL OR MICRO ;
IFC CMUVER THENC BOOLEAN FIRST!OUTPUT ; ENDC RKJ: 10-SEP-74 ;
BOOLEAN NEEDFONTS ; TES 10/17/74 FOR PARC MIC ;
BOOLEAN NEEDVERTI ; TES 11/4/74 ;

INTEGER FLUSHING, FSIZE; comment kludges for XGP ;
EXTERNAL INTEGER RPGSW ;
STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S, SR,
	OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
STRING SPSSTR ; COMMENT A STRING OF 200 SPACES (TES 8/28/74) ;
TES 1/7/74 ; STRING CMDFILE ;
TES 3/20/74 ; STRING IFILENAME ; INTEGER IFICHAN ;

REAL RATIO ;

INTEGER ARRAY CHARTBL[0:127], XFILL,XINF,SLIDESG,RB,LBD[1:5] ;
INTEGER ARRAY FNTSIZE,FNTCHAN[0:35] ;

STRING ARRAY LBF[1:5] ;

PRELOAD!WITH "", " ", "  ", "   ", "    ", "     ", "      ",
	"       ", "        ", "         ", "          " ;
THAFE STRING ARRAY SPSARR[0:10] ;

TES ADDED ALL PARC MIC STUFF ABOUT 8/28/74 :   ;

IFCR PARCVER THENC
PARCODES
PARCARRAYS
ENDC
SIMPLE PROCEDURE WARN(STRING MESSG) ;
	USERERR(0,1,MESSG) ;

INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
BEGIN "READIN"
INTEGER CH, FLAG ;
CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
LOOKUP(CH, FILENAME, FLAG) ;
IF FLAG THEN WARN("Pass one said to read this file: " &
	FILENAME & " but it does not exist") ;
RETURN(CH) ;
END "READIN" ;

INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
IFC TENEX THENC
OPENFILE(FILENAME, "WC") ;
ELSEC
BEGIN "WRITEON"
INTEGER CH ;
CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
AWHILE DO		RKJ: 23-JUL-74 - CHECK FOR ENTER FAILURE ;
	BEGIN
	ENTER(CH, FILENAME, DUMMY←0);
	IF NOT DUMMY THEN DONE;
	OUTSTR("Cannot ENTER """ & FILENAME & """  Write file: ");
	FILENAME←INCHWL;
	END;
RETURN(CH);
END "WRITEON" ;
ENDC

IFC TENEX THENC
INTEGER SIMPLE PROCEDURE WRITE16(STRING FILENAME) ;
BEGIN "WRITE16"
INTEGER CH ;
CH ← GTJFN(FILENAME, 1) ;
IF CH<0 THEN WARN("Error in GTJFN of Document file " & FILENAME) ;
OPENF(CH, '200000100000) ;
IF !SKIP! THEN
	BEGIN
	ERSTR(!SKIP!,0) ;
	WARN("Error opening Document file " & FILENAME) ;
	END ;
RETURN(CH) ;
END "WRITE16" ;
ENDC

STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
	RETURN('177 & OP & (IF OP LEQ '42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;

RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
BEGIN "VARBLANK"
IFC CMUXGP THENC
	IF N  LEQ  0 THEN RETURN(NULL) ELSE
	IF N  GEQ  128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
	RETURN(VSB&N)
ELSEC IFC SAILXGP THENC
	IF N  LEQ  0 THEN RETURN(NULL) ELSE
	IF N  GEQ  64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
	RETURN(ESCAPE2&N)
ELSEC IFC PARCVER THENC
	RETURN(CTLE&CVS(N)&".")
ENDC ENDC ENDC;
END "VARBLANK";

INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ;
	IF N LEQ 10 THEN RETURN(SPSARR[N MAX 0])
	ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
	ELSE RETURN(SPSSTR[1 TO N]) ;

IFC TENEX THENC
STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
	BEGIN
	INTEGER DUMMY ;
	SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
	RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
	END ;
ENDC

IFC PARCVER THENC PARCOUT ENDC

STRING SIMPLE PROCEDURE SPARAM ;
	BEGIN "SPARAM"
	STRING S ;
	S ← NULL ;
	DO S ← S & INPUT(SEQCHAN, TO!ALTMODE!SKIP) UNTIL SEQBRC = ALTMODE OR SEQEOF ;
	RETURN(S) ;
	END "SPARAM" ;

INTEGER SIMPLE PROCEDURE IPARAM ; RETURN(CVD(SPARAM)) ;

IFC CMUXGP THENC   RKJ: 29-AUG-74;

INTEGER SIMPLE PROCEDURE INDEX2(STRING A,B);
comment returns the location of the first occurance of
	the string B in A, 0 if none;
BEGIN "INDEX2"
	INTEGER LA, LB;
	IF (LB←LENGTH(B))=0 THEN RETURN(1);
	IF (LA←LENGTH(A)-LB+1) LEQ 0 THEN RETURN(0);
	START!CODE
	    LABEL L1, L2, OUTT, NEXT;
	    MOVE 2,A; MOVN 1,LA; ILDB 0,B; SOS 0,LB;
	    L1: ILDB 3,2; CAME 3,0; NEXT: AOJL 1,L1;
	    JUMPE 1,OUTT;
	    MOVE 4,2; MOVE 5,B; MOVE 6,LB;
	    L2: ILDB 7,4; ILDB '10,5; CAME 7,'10; JRST NEXT; SOJG 6,L2;
	    ADD 1,LA; AOJ 1,0;
	    OUTT:
	END;
END "INDEX2";

SIMPLE STRING PROCEDURE FIXUP(STRING S);
	BEGIN "FIXUP"
	INTEGER ALOC,BLOC;
	IF NOT XCRIBL THEN RETURN(S) ; RKJ: 28-SEP-74 ;
	IF (ALOC←INDEX2(S,USEA))=1 THEN RETURN(S);
	IF (BLOC←INDEX2(S,USEB))=1 THEN RETURN(S);
	IF ALOC=0 THEN ALOC←BLOC;
	IF BLOC=0 THEN BLOC←ALOC;
	ALOC←ALOC MIN BLOC;
	RETURN(S[ALOC FOR 2]&S[1 TO ALOC-1]&S[ALOC+2 TO ∞]);
	END "FIXUP";
ELSEC
	DEFINE FIXUP(X)="X";
ENDC

IFC TENEX THENC
SIMPLE PROCEDURE SFBSZ(INTEGER CHAN, SIZE) ;
	BEGIN "SFBSZ"
	INTEGER K ;
	DEFINE JSYS=['104000000000], SFBSZ=[JSYS '46];
	K ← CVJFN(CHAN) ;
	START!CODE "BYTE16"
	MOVE 1,K; MOVE 2,SIZE; SFBSZ ;
	END "BYTE16" ;
	END "SFBSZ" ;
ENDC
ONE ← 1 ; COMMENT TO FORCE ARRAY TO BE DYNAMIC ;
BEGIN "VARIABLE BOUND ARRAY BLOCK"
THAFE INTEGER ARRAY CW[0:ONE] ;
REQUIRE "DATUM" SOURCE!FILE ;
REQUIRE "FONTS" SOURCE!FILE ;

BOOLEAN SIMPLE PROCEDURE READFONT(INTEGER WHICH) ;
BEGIN
INTEGER CHAN ;
FNTCHAN[WHICH] ← CHAN ←
	IFC PARCVER THENC OPENFILE(FNTNAME[WHICH], "RO")
	ELSEC READIN(FNTNAME[WHICH], TRUE, BRC, EOF) ENDC ;
IF CHAN<0 THEN WARN("Can not open font file " &
	FNTNAME[WHICH] & "  in pass two.  This is a bug") ; TES 10/18/74 ;
BRC ← FNTFIL[WHICH] ← CREATE(0,127) ; MAKEBE(BRC, CW) ;
FNTSIZE[WHICH] ← PERUSEFONT(WHICH, CHAN) ;
IFC PARCVER THENC RETURN(FNTNUMBER[WHICH]<0) TES 10/17/74 ;
ELSEC RELEASE(CHAN) ENDC ;
END "READFONT" ;

COMMENT I N I T I A L I Z E ;

WCW ← WHATIS(CW) ;

IFC PARCVER THENC
SR ← NULL ;
DUMMY←CVSIX("PUB2  ");
	START!CODE
	 MOVE 1,DUMMY;
	 '104000000210;
	END;

ARRCLR(NILS, 1) ;
ENDC

SPSSTR ← SP ;
FOR I ← 1 THRU 200 DO SPSSTR ← SPSSTR & SP ; TES 8/28/74 ;

SCRIPT ← 10;
IFC TENEX THENC JOBNO ← CVS(GJINF(DUMMY, DUMMY, DUMMY)) ; ENDC TES 10/25/73 ;

IFC PARCVER THENC IML←65; IMC←72; ENDC
IFC SAILVER THENC IML←53; IMC←69; ENDC
IFC ITSVER THENC IML←55; IMC←69; ENDC PJ 5/28/74 ;
IFC CMUVER THENC IML←55; IMC←69; ENDC
IFC ISIVER THENC IML←55; IMC←69; ENDC
PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
SETBREAK(ONE!CHAR, NULL, NULL, "XA") ;
SETBREAK(TO!ALTMODE!SKIP, ALTMODE, NULL, "IS") ;
SETBREAK(TO!LF!APPD, LF, NULL, "IA") ;
SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
SETBREAK(TO!RUB!ALT!SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
IFC TENEX THENC
	IF RPGSW THEN
		BEGIN
		IFICHAN ← READIN(JOBNO & ".PASS2", FALSE, DUMMY, DUMMY) ;
		IFILENAME ← INPUT(IFICHAN, TO!ALTMODE!SKIP) ;
		RELEASE(IFICHAN) ; TES 6/11/74 ;
		END
	ELSE	BEGIN TES 6/11/74 REVISED ;
		OUTSTR("MANUSCRIPT: ") ;
		WHILE -1 = (J ←
		GTJFNL(NULL, '162000000000, '100000101,
			NULL, NULL, NULL, "PUB", NULL, NULL, NULL)) DO
		OUTSTR("  ?" & CRLF & "MANUSCRIPT: ") ;
		IFILENAME ← JFNS(J, '1000000000) ;
		RLJFN(J) ;
		END ;
	ENDC

OUTSTR("PASS TWO  ") ;

SEQCHAN ← READIN(
	IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
	 FALSE, SEQBRC, SEQEOF) ;

TMPFILE ← SPARAM ;
LISTFILE ← SPARAM ;

DEBUG ← IPARAM ;

DEVICE ← IPARAM ;
XCRIBL ← DEVICE=XGP ;
IFC PARCVER THENC
	MICRO ← DEVICE=MIC ;
	PDIX ← OUTCOUNT ← 0 ;
	IF MICRO THEN
		BEGIN
		DLBP1 ← '041000677777 ; COMMENT BYTE POINTER ;
		END ;
ELSEC MICRO ← FALSE ; ENDC ;
RASTER ← MICRO OR XCRIBL ;

DELINT ← SPARAM ;

LOFONT ← IPARAM ; HIFONT ← IPARAM ;
NEEDFONTS ← FALSE ; TES 10/17/74 ;
FOR J ← LOFONT THRU HIFONT DO
	IF FULSTR(FNTNAME[J] ← SPARAM) THEN
		IF READFONT(J) THEN NEEDFONTS ← TRUE ;
IFC PARCVER THENC
IF MICRO AND NEEDFONTS THEN
	BEGIN TES 10/17/74 ;
	K ← -1 ;
	FOR J ← LOFONT THRU HIFONT DO IF FULSTR(FNTNAME[J]) THEN
		FNTNUMBER[J] ← K ← K + 1 ;
	END ;
ENDC

CMDFILE ← SPARAM ;

BAR ← SPARAM[1 FOR 1] ;
IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;

CHARW ← IPARAM;
NEEDVERTI ← FALSE ;
IF (MILLVERTI←IPARAM) LEQ 0 THEN
	BEGIN
	INTRA ← IFC NOT SAILXGP THENC 0 ; BH 11/19/74 ; ENDC
		MILLVERTI ← ABS(MILLVERTI) ;
	NEEDVERTI ← RASTER ;
	END
ELSE INTRA ← MILLVERTI ;
BASELINE ← IPARAM; BASELINE←BASELINE+(BASELINE DIV 4);
DOPASS3 ← IPARAM;   RKJ: 1-4-74;
IFC CMUVER THENC FIRST!OUTPUT ← NOT DOPASS3 ; ENDC RKJ: 28-SEP-74 ;
VBPI ← IPARAM ;
HBPI ← IPARAM ;
MINLFTMAR ← IPARAM ;

INTRA ← (INTRA*VBPI + 500)/1000 ; TES 11/2/74 ;
RASTVERTI ← (MILLVERTI*VBPI + 500)/1000 ; TES 11/2/74 ;


IF  NOT RPGSW AND NOT RASTER THEN COMMENT STARTED BY ".R PUB2" ;
DO	BEGIN
	OUTSTR("OUTPUT DEVICE (LPT or  TTY): ") ;
	S ← INCHWL ;
	DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE 0 ;
	END
UNTIL DEVICE ;
IF  NOT RPGSW AND DEBUG THEN
IF DEVICE = MIC THEN DEBUG ← 0
ELSE DO	BEGIN
	OUTSTR("Debug info in right margin? (Y or N) = ") ;
	S ← INCHWL ;
	DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
	END
UNTIL DEBUG < 100 ;

ENDLINE ← LF ; ENDPAGE ← FF ;
IFC PARCVER THENC IF MICRO THEN ENDLINE ← MEOL ; ENDC
RESTARTLINE ←
IFC PARCVER THENC IF XCRIBL THEN CTLT&"0." ELSE CR
ELSEC CR ENDC ; TES 11/1/73 ;

IFC SAILVER THENC
CASE DEVICE-1 OF
BEGIN "DEV"
comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
	IF DEBUG THEN BEGIN OUTSTR(CRLF&"Won't put Debug info on Microfilm"&CRLF) ;
			DEBUG ← FALSE ; END END ;
COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
END "DEV" ;
ELSEC
IFC PARCVER THENC
IF MICRO THEN LISTCHAN ← WRITE16(LISTFILE) ELSE
ENDC
LISTCHAN ← WRITEON(LISTFILE) ;
ENDC
IFC TENEX THENC LISTFILE ← JFNS(LISTCHAN, 0) ; ENDC
OUTSTR(LISTFILE) ;

J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;

LABCHAN ← READIN(
	IFC TENEX THENC IFILENAME&".LABELS" ELSEC "PULABL"&PUIEXT ENDC,
	 FALSE, LABBRC, LABEOF) ;
NL ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ;

LASL ← 1000 ; comment, last physical line occupied on the page ;

S←INPUT(SEQCHAN,TO!LF!APPD); comment get to right place ;

TES 1/7/74 ADDED : TES 6/11/74 WITH INTRA:;
IFC PARCVER THENC
IF XCRIBL THEN OUT(LISTCHAN,
	(RUBOUT&CTLC) & CMDFILE &
		("K EFHJKLMQRSTU" & CR & "I " & CVS(INTRA) &
			CR & "M 0" & CR & "W 1600" & CR & "E" & CR)) ;
COMMENT
	CTLC		Initiallize switches (used as RUBOUT CTLC)
	CTLE		Variable blank
	CTLF		Font change
	CTLH		Overstrike
	CTLJ=LF		Line Feed
	CTLK		Vertical Spacing
	CTLL=FF		Form Feed
	CTLM=CR		Carriage Return
	CTLQ		Quote control character
	CTLR		Return to baseline from ript
	CTLS		Subscript
	CTLT		Tab
	CTLU		Superscript
	RUBOUT		Treat as control character (inverse CTLQ)
	;
ENDC

IFC SAILVER THENC
IF XCRIBL THEN
	OUT(LISTCHAN,"/LMAR="&CVS(LFTMAR)&"/XLINE="&CVS(INTRA)&CMDFILE&CRLF&FF) ;
ENDC
IFC ITSVER THENC PJ 8/24/74 ;
IF XCRIBL THEN OUT(LISTCHAN,";LFTMAR "&CVS(LFTMAR)&CRLF&
			    ";VSP "&CVS(INTRA)&CRLF&
			    ";SKIP 1"&CRLF&
			    CMDFILE&CRLF&FF);
ENDC
BEGIN "INNER BLOCK"

STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;

AWHILE DO
	BEGIN "LABEL"
	TABLE ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ; IF LABEOF THEN DONE ;
	LABTAB[TABLE, CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP))] ←
		INPUT(LABCHAN, TO!ALTMODE!SKIP) &
		(IF RASTER THEN
			(ALTMODE & INPUT(LABCHAN, TO!ALTMODE!SKIP))
		   ELSE NULL);
	END "LABEL" ;

RELEASE(LABCHAN);

COMMENT  G O !  ;

IF MICRO THEN IML ← 1 ; COMMENT SAVE STORAGE ;
DO comment, This loop is re-entered only if page image grows ;

BEGIN "SIZE"
THAFE STRING ARRAY IMG[1:IML+IML], SEG[0:8*IMC], SRCREF[1:IML] ;
THAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML], LEADING[1:IML+1] ;
LABEL CONTINUE ;

	COMMENT		* * * * A P P D * * * *		;

INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
IFC PARCVER THENC PARCAPPD ENDC
BEGIN "APPD"
INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
L ← LINE ; EXTRA ← LENGTH(S) ;
IF XCRIBL THEN
	BEGIN TES 11/13/73 FOR MULTI-COLUMNS ;
	IF CHAR < (HAD ← LASC[L]) THEN
		BEGIN
		FAKE[L] ← FAKE[L] + HAD - CHAR ;
		HAD ← LASC[L] ← CHAR ;
		END
	END
ELSE
WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
	IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN
		WARN("Too much for one page: " & S)
	ELSE L ← AVAIL ;
SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
T ← IMG[L] ;
IF LENGTH(T) < HAD+SPACES+EXTRA THEN
	BEGIN comment no room -- must use concatenate ;
	SS ← SPS(SPACES) ;
	IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
	IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞]
	END
ELSE BEGIN comment there's room in old string -- IDPB into it.;
	SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
	START!CODE "APPEND" LABEL LOOP1, LOOP2 ;
	MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
	MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
	LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
	END "APPEND" ;
     END ;
RETURN(LASC[L] ← CHAR + EXTRA) ;
END "APPD" ;

	COMMENT		* * * * C T R L * * * *		;

SIMPLE PROCEDURE CTRL(STRING S) ;
BEGIN "CTRL"
CHAR ← 0 MAX APPD(S) - LENGTH(S) ;
LASC[L] ← CHAR ;
FAKE[L] ← FAKE[L] + LENGTH(S) ;
END "CTRL" ;

SIMPLE PROCEDURE MCTRL(INTEGER C) ;
BEGIN "MCTRL"
QUICK!CODE "MCTRLAPPEND"
LABEL RBYTE ;
DEFINE WD=['13] ;
MOVE WD, C ;
CAIG WD,'377 ;
JRST RBYTE ;
ROT WD, -8 ;
IDPB WD, DLBP ;
ROT WD, 8 ;
RBYTE:
IDPB WD, DLBP ;
END "MCTRLAPPEND" ;
END "MCTRL" ;
SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
BEGIN "UNDERSCORE"
INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
NUMCHARS ← RIGHTCHAR - UNDERLINE ;
IF NUMCHARS > 0 THEN
	BEGIN
	SAVEHORIZ ← CHORIZ ;
	DESCEND ← CCSIZE DIV 4 ;
	CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
		SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
		DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
	UNDERLINE ← RIGHTCHAR ;
	END ;
END "UNDERSCORE" ;

SIMPLE PROCEDURE CHANGESPACING ;
	IF (N←CHRS-CHAR-1)>0 AND (K←(J←N*CHORIZ+SHORTM)/N MIN 511) NEQ CHORIZ THEN
		BEGIN "CHANGESPACING"
		IF UNDERLINE GEQ 0 THEN UNDERSCORE(CHAR) ;
		SHORTM ← J - K*N ;
		IF NOTFST AND (UNDERLINE<0 OR SHORTM<0) THEN
			BEGIN CTRL(DORDOTS(SHORTM)) ; SHORTM ← 0 END ; TES CTRL 8/28/74;
		CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
		END "CHANGESPACING" ;

SIMPLE PROCEDURE FONTSELECT(INTEGER WHICH);
BEGIN "FONTSELECT"
IF (WHICH←WHICH-"0")>9 THEN WHICH←WHICH-("A"-"0"-10);
THISFONT ← WHICH ; TES 10/17/74 ;
IFC CMUXGP THENC
	WHICH←WHICH MOD 9;  COMMENT MAKE 1,A  2,B  EQUIVALENT;
	IF WHICH=1 THEN CTRL(USEA) ELSE
	IF WHICH=2 THEN CTRL(USEB) ELSE
	WARN("Font " & CVS(WHICH) & " ignored")
ELSEC IFC SAILXGP THENC
	IF WHICH>16 THEN WARN("Font " & CVS(WHICH) & " ignored") ELSE
	BEGIN
	CTRL(ESCAPE1&(WHICH-1));
	IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
	END;
ELSEC IFC PARCVER THENC
	PARCFONT
ENDC ENDC ENDC;
END "FONTSELECT";

STRING SIMPLE PROCEDURE XTABSTR(INTEGER N);  RKJ: NEW 1-4-74;
BEGIN "XTABSTR"
	IFC CMUXGP THENC RETURN(XTAB&XGPNUM(N)) ENDC
	IFC SAILXGP THENC
		RETURN(ESCAPE1&'40&XGPNUM(N))
	ENDC
	IFC PARCVER THENC
	    RETURN(CTLT&CVS(N)&".")
	ENDC;
END "XTABSTR";

SIMPLE PROCEDURE XGPTAB(INTEGER N);   RKJ: NEW 1-4-74;
	CTRL(XTABSTR(N+TLFTMAR));

STRING PROCEDURE SCNBYCOUNT(INTEGER COUNT) ;
BEGIN
INTEGER I ; STRING S ;
S ← NULL ;
FOR I ← 1 THRU COUNT DO S ← S & SCN(ONE!CHAR) ;
RETURN(S) ;
END ;

SIMPLE STRING PROCEDURE UNMASH(STRING Q) ;
BEGIN TES 8/14/74 PACK EXCESS-64 4-BIT BYTES INTO 7-BIT BYTES ;
STRING S ; S ← NULL ;
WHILE FULSTR(Q) DO S ← S & (((LOP(Q)-64)LSH 4) + (LOP(Q)-64)) ;
RETURN(S) ;
END ;

SIMPLE INTEGER PROCEDURE BYTECOUNT(INTEGER BPNOW, BPTHEN) ;
	RETURN(
	((RH(BPNOW)-RH(BPTHEN)) LSH 2) + ((28-((BPNOW ROT 6) LAND '77)) LSH -3) - 3
	) ;

IFC PARCVER THENC PARCLINE ENDC

SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ;
BEGIN "IMPOSSIBLE"
IF SG > -1 THEN
	BEGIN
	OUTSTR(CRLF & HOW & " Error."&CRLF&
		  "This is an encoding of text line " & CVS(LINE) & ":" & CRLF) ;
	FOR I ← 1 THRU SG DO OUTSTR(SEG[I]) ;
	END ;
WARN("A supposedly impossible condition has been encountered."&CRLF&
	"This is most likely a PUB bug.  However, you may have an error"&CRLF&
	"which produced unanticipated line lengths or other strange effects."&
	(IF DEBUG THEN CRLF&"Line/Page: "&SRCREF[LINE] ELSE NULL)) ;
END "IMPOSSIBLE" ;
SIMPLE PROCEDURE SLIDERROR ;
	BEGIN
	IMPOSSIBLE(CVS(SLIDETOP)&" Horizontal Positioning") ;
	SLIDETOP ← 1 ;
	END ;

SIMPLE PROCEDURE RIGHTBOUND ;
	BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
	INTEGER DEST, FILLIN, I ;  STRING FILLER, OLBF ;
	INTEGER XF; STRING XTO ; TES 3/30/74;
	IF SLIDETOP < 1 THEN SLIDERROR ;
	IF LBD[SLIDETOP] < -900 THEN COMMENT FLUSH RIGHT ;
	    BEGIN
		IF RASTER THEN
			BEGIN
			XF←RB[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE);
			XTO ← "=" ;
			END ;
		FILLIN←RB[SLIDETOP]-CHRS;
	    END
	  ELSE COMMENT CENTER ;
	    BEGIN
		IF RASTER THEN
			BEGIN
			XF ← (RB[SLIDETOP]-LBD[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE)) DIV 2;
			XTO ← "+" ;
			END ;
		FILLIN ← ((RB[SLIDETOP]-CHRS) DIV 2) MAX 0;
	    END;
	DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
	IF FULSTR(OLBF) THEN
	    IF RASTER THEN
		BEGIN "XGPINFINITY"
		FILLER ← NULL ;
		FOR I ← 1 THRU XINF[SLIDETOP] DO FILLER ← FILLER & OLBF ;
		SEG[I ← SLIDESG[SLIDETOP]] ← FILLER ;
		SEG[I + 1] ← RUBOUT & XTO & CVS(XF) ;
		END "XGPINFINITY"
	    ELSE
		BEGIN "NON-BLANKS"
		FILLER ← NULL ;
		WHILE CHRS < DEST DO
			BEGIN
			FILLER ← FILLER & OLBF ;
			CHRS ← CHRS + LENGTH(OLBF) ;
			END ;
		IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
		SEG[SLIDESG[SLIDETOP]] ← FILLER ;
		END "NON-BLANKS"
	ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT &
			(IF RASTER THEN (XTO&CVS(XF))
					 ELSE ("+"&CVS(FILLIN))  );
	CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
	BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
	FLUSHING ← FALSE ;  FSIZE ← 0 ;
	END "RIGHTBOUND";

SIMPLE INTEGER PROCEDURE STEP!SG ;
IF SG<8*IMC THEN RETURN(SG←SG+1)
ELSE	BEGIN
	IMPOSSIBLE("Line complexity") ;
	RETURN(SG←0) ;
	END ;
IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
AWHILE DO
BEGIN "FILE"
PAGEFILE ← SPARAM ; IF SEQEOF THEN DONE ;
IFC TENEX THENC
IFILE ← IFILENAME & OCTEXT & PAGEFILE ;
SFILE ← IFILENAME & TXTEXT & PAGEFILE ;
ELSEC
IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
ENDC
ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;

AWHILE DO
BEGIN "PAGE"
PAGEHIGH ← INNUM ; IF PAGEEOF OR PAGEHIGH LEQ 0 THEN DONE ; PAGEWIDE ← INNUM ;
LFTMAR ← 0 MAX (INNUM*HBPI + 500)/1000 - MINLFTMAR ; TES 6/11/74 ADDED ;
RGTMAR ← 0 MAX ((8500-INNUM)*HBPI + 500)/1000 - MINLFTMAR ; TES 8/29/74 ADDED ;
	COMMENT HBPI HORIZ BITS PER INCH, MINLFTMAR BIT MIN MARGIN;
IF NOT MICRO AND (PAGEHIGH > IML OR PAGEWIDE > IMC) THEN
	BEGIN "EXPAND"
      IFC SAILVER THENC
	IF DEVICE=MIC THEN
		BEGIN "FRAME SIZE"
		IF LASL NEQ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
		NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
		NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
		OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
		END "FRAME SIZE"
	ELSE IF DEVICE = LPT THEN
		BEGIN
		IF (LASL-1) MOD 66 + 1 LEQ 6 AND (PAGEHIGH-1) MOD 66 < 60 THEN
			OUT(LISTCHAN, ENDPAGE) ;
		ENDLINE ← IF PAGEHIGH GEQ 54 THEN RUBOUT & '21 ELSE LF ;
		END ;
      ENDC;
	IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
	DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
	END "EXPAND" ;

CONTINUE: OUTSTR(SP & CVS(PAGECT ← PAGECT + 1)) ; AVAIL ← IML ;
TOPMAR ← BOTMAR ← VBPI ; COMMENT *** TEMP VALUE -- 1" ;
RASTPHIGH ← 11*VBPI - (TOPMAR+BOTMAR) ; COMMENT *** TEMP *** ;
RASTPWIDE ← (17*HBPI)/2 - (LFTMAR+RGTMAR) ; COMMENT *** TEMP *** ;
RASTLHIGH ← RASTPHIGH/PAGEHIGH ;
IFC SAILVER THENC
IF PAGECT > 1 THEN
IF DEVICE = LPT THEN	COMMENT AVOID SPURIOUS BLANK PAGE ;
	IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
	ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
		BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END
ELSE OUT(LISTCHAN, ENDPAGE) ;
ENDC
IFC CMUXGP THENC
IF PAGECT>1 THEN OUT(LISTCHAN,ENDPAGE);
ENDC

IFC PARCVER THENC
IF MICRO THEN
	BEGIN
	FSTFONT ← -1 ;
	DLBP ← DLBP1 ;
	TLIX ← 0 ;
	END ;
ENDC
WHILE (TOPLINE ← INNUM) > -10 DO
BEGIN "AREA"
NCOLS ← INNUM ; NLINES ← INNUM ;
FOR COL ← 1 THRU NCOLS DO
BEGIN "COLUMN"
LEFTCH ← INNUM ;
TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ; TVR: Initiallize left margin for this column ;
WHILE (LINENO ← INNUM) DO
BEGIN "LINE"
SH ← SHORTM ← INNUM ;
MLEAD ← INNUM ; TES 11/2/74 ;
SG ← FSTBRK ← -1 ;
BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
LINE ← TOPLINE - 1 + LINENO ;
IF LINE<1 OR LINE>PAGEHIGH THEN
	BEGIN
	WARN("Area outside page.  If Pass one didn't tell you too, then there is a bug in PUB");
	LINE←LINE MAX 1 MIN PAGEHIGH ;
	END ;
L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
ELSE BEGIN FROMFILE ← TRUE ;
	WHILE L NEQ (M←CVD(INPUT(SCHAN, TO!ALTMODE!SKIP))) DO
		BEGIN S ← NULL ;
		RKJ: 4-26-74, added EOF stuff on next two lines ;
		DO S ← S & INPUT(SCHAN, TO!LF!APPD) UNTIL PAGEBRC = LF OR PAGEEOF ;
		IF PAGEEOF THEN USERERR(0,0,"Bad input from Pass One (a PUB bug), I give up.");
		OWLS[M MOD FIML] ← S ;
		END ;
	END ;
IF  NOT DEBUG THEN S ← SCN(TO!ALTMODE!SKIP)
ELSE	BEGIN
	SR ← IF MICRO THEN NULL ELSE SRCREF[LINE] ;
	SR ← SR & "   " & SCN(TO!RUB!ALT!SKIP) ;
	WHILE PAGEBRC NEQ ALTMODE DO
		BEGIN "ERROR MESSG"
		S ← SCN(TO!RUB!ALT!SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
		IF DEVICE=TTY OR (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SR)+M LEQ 119 THEN
			SR ← SR & "..." & S ;
		END "ERROR MESSG" ;
	IF NOT MICRO THEN SRCREF[LINE] ← SR ;
	END ;
DO BEGIN "PIECE"
S ← SCN(BREAKER) ; TES 11/6/74 ;
WHILE NOT PAGEEOF AND NOT PAGEBRC DO
	S ← S & SCN(BREAKER) ; TES 11/6/74 ;
CHRS ← CHRS + LENGTH(SEG[STEP!SG] ← S) ;
CASE CHARTBL[PAGEBRC] OF
BEGIN comment by BRC ;

comment 0 ... ; IMPOSSIBLE("0"&CVOS(PAGEBRC)&" Break Character") ;

comment 1 ... RUBOUT -- Font change ; BEGIN
	SEG[STEP!SG] ← RUBOUT & (F←SCN(ONE!CHAR)) &
		(S ← IF F="-" OR F="+" OR F="=" THEN SCN(TO!ALTMODE!SKIP)
		ELSE IF F = "F" THEN SCN(ONE!CHAR)
		ELSE IF F="π" THEN SCNBYCOUNT(SCN(ONE!CHAR))
		ELSE NULL) ;
	IF F = "π" THEN CHRS ← CHRS + 1
	ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
	ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
	ELSE IF F = "→" THEN
		BEGIN COMMENT ∞ ;
		IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN SLIDERROR ;
		SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
		LBD[SLIDETOP] ← SCNUM ;
		IF RASTER THEN
			BEGIN
			RKJ; XFILL[SLIDETOP] ← SCNUM ;
			TES ; XINF[SLIDETOP] ← SCNUM ;
			END ;
		LBF[SLIDETOP] ← SCN(TO!ALTMODE!SKIP) ;
		IF RASTER AND FULSTR(LBF[SLIDETOP]) THEN STEP!SG ;   RKJ: 1-9-74;
		FLUSHING ← TRUE;
		END
	ELSE IF F = "←" THEN
		RIGHTBOUND
	ELSE IF F = "=" THEN BEGIN
comment 8/9/73 RKJ		IF RASTER THEN SHORTM←(SHORTM-BRKS*CHARW) MAX 0;
				 BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
				END ; COMMENT NOJUST LEFT OF TAB ;

comment 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[STEP!SG] ← ALTMODE END ;

comment 3 ... VT -- label reference ;
	BEGIN "LABEL REF"
	STRING S;
	S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
	L ← LENGTH(SEG[STEP!SG] ← SCAN(S, TO!ALTMODE!SKIP, DUMMY)) ;
	J ← CVD(S) ;
	SHORTM ← SHORTM - (IF RASTER THEN J ELSE L) ; CHRS ← CHRS + L ;
	IF FLUSHING AND RASTER THEN FSIZE←FSIZE+J ;
	END "LABEL REF" ;
comment 4 ... CR -- Justify it ;
BEGIN "JUSTIFY"
WHILE SLIDETOP DO BEGIN SLIDERROR ; RIGHTBOUND END ;
IF SHORTM < 0 THEN SHORTM ← 0 ;
IFC SAILVER THENC IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ ELSE ENDC
	BEGIN "DISTRIBUTE SPACES"
	COMMENT beta(α,K) = [α(K+1)] - [αK], PJ 5/27/74 ITS doesn't like <control-C>'s
		WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
	RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
	END "DISTRIBUTE SPACES" ;
UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN PAGEHIGH ; CHAR ← 0 MAX LEFTCH-1 MAX 0 ;
IFC CMUVER THENC IF XCRIBL THEN CHAR←LASC[LINE]; ENDC   RKJ: 7-Nov-74, needed for multi column;
NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;

TVR: Initial column select for XGP ;
IF XCRIBL AND (LEFTCH NEQ 1 OR LFTMAR > 0) THEN XGPTAB(0) ;
IFC PARCVER THENC IF MICRO THEN OPENLINE(0, -1) ; ENDC

IF XCRIBL THEN LEADING[LINE] ←		TES 11/4/74;  RKJ: 7-Nov-74;
	IF MLEAD = 0 THEN 0
	ELSE IF MLEAD > 0 THEN (MLEAD*VBPI + 500)/1000
	ELSE -((-MLEAD*VBPI + 500)/1000) ;

IFC SAILVER THENC
IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
ENDC
FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
BEGIN comment three cases ;

comment 0 ... text ;
BEGIN "TEXT SEG"
IF UNDERLINE<0  OR BAR=0 TES 10/22/73 ;  THEN CHAR ← 0 MAX APPD(S) ELSE
COMMENT		*** UNDERLINING ***		;
IF DEVICE = MIC THEN
    IFC SAILVER THENC
	BEGIN	K ← LENGTH(S) ;
	WHILE K DO
		BEGIN COMMENT DON'T UNDERLINE BLANKS ;
		N ← LOP(S) ;
		IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
		K ← K - 1 ;
		END ;
	END
    ENDC
    IFC PARCVER THENC PARCBAR ENDC
ELSE IF XCRIBL THEN
	BEGIN
    IFC CMUXGP THENC
	K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
	START!CODE "XGPUNDER"
	DEFINE LEN= [2],SRC= [3],DEST= [4],RUB= [5],ESC= [6],R= [7],CNT= ['10],UBAR= ['11];
	LABEL LOOP,ELOOP,SPACE,OUTT;
	SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVE UBAR,BAR;
	LOOP:	ILDB R,SRC;
		CAIE R,BAR; CAIN R,SP; JRST SPACE;
		IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
	ELOOP:	SOJG LEN,LOOP;
		MOVEM CNT,N; JRST OUTT;
	SPACE:	IDPB R,DEST;
		AOJA CNT,ELOOP;
	OUTT:
	END "XGPUNDER";
	CHAR ← 0 MAX APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
	LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
    ENDC
    IFC SAILXGP THENC CHAR ← 0 MAX APPD(S); ENDC
    IFC PARCVER THENC
	K←LENGTH(S); SS←0&SPS(K*3); N←LOP(SS);
	START!CODE "XGPUNDER"
	DEFINE LEN= [2],SRC= [3],DEST= [4],BS= [5],UBAR= [6],CNT= [7],R= ['10];
	LABEL LOOP, OUTT, NOBAR; TES 8/19/74 TES CHAR BS BAR -> BAR BS CHAR, FOR BOBROW ;
	SETZ CNT,0;
	MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI BS,'10; MOVE UBAR,BAR;
	LOOP:	SOJL LEN,OUTT;
		ILDB R,SRC;
		CAIE R,BAR; CAIN R,SP; AOJA CNT,NOBAR;
		IDPB UBAR,DEST; IDPB BS,DEST;
		NOBAR: IDPB R,DEST;
		JUMPA LOOP;
	OUTT:	MOVEM CNT,N;
	END "XGPUNDER";
	CHAR ← 0 MAX APPD(SS[1 TO (K*3-N*2)])-(K-N)*2;
	LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*2;
    ENDC
	END
ELSE	BEGIN CHAR ← 0 MAX APPD(S);
	K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR ← 0 MAX CHAR-K ;
		IFC NOT CMUXGP THENC   RKJ: 1-7-74;
		START!CODE "UNDER" LABEL LOOP ;
		MOVE 2, K ; MOVE 3, SS ;
		LOOP: ILDB 4,3 ; CAIE 4,SP ; CAIN 4,BAR ; CAIA 0,0 ; MOVE 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
		END "UNDER" ;	CHAR ← 0 MAX APPD(SS[1 TO LENGTH(S)]) ;
		ELSEC CHAR ← 0 MAX APPD(S); ENDC   RKJ: 1-7-74;
	END ;
END "TEXT SEG" ;

comment 1 ... RUBOUT -- Font Change ;
	IF (F←S[2 FOR 1])="↑" THEN
	  IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE ENDC
	IFC PARCVER THENC
	  IF MICRO THEN PARCSUPER ELSE
	  IF XCRIBL THEN
	   IF (SCRLVL←SCRLVL+SCRIPT) LEQ 0 THEN CTRL("R"-'100) ELSE
	    BEGIN LABEL L1;
	    CTRL("U"-'100);
	    L1:
	    IF G<SG THEN
		BEGIN
		SS←SEG[G+1];
		IF NULSTR(SS) THEN BEGIN G←G+1; GO L1 END; comment try again ;
		IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
		    BEGIN
		    G←G+1;
		    CTRL(SS[3 FOR 1]);
		    END ELSE CTRL(THISFONT+"0");
		END ELSE CTRL(THISFONT+"0")
	    END
	ELSE ENDC
	  IFC SAILXGP THENC
	    IF XCRIBL THEN
		CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
	  ELSE ENDC LINE←LINE-1 MAX 1
	ELSE IF F = "↓" THEN
	  IFC SAILVER THENC IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE ENDC
	IFC PARCVER THENC
	  IF MICRO THEN PARCSUB ELSE
	  IF XCRIBL THEN
	   IF (SCRLVL←SCRLVL-SCRIPT) GEQ 0 THEN CTRL("R"-'100) ELSE
	    BEGIN LABEL L2;
	    CTRL("S"-'100);
	    L2:
	    IF G<SG THEN
		BEGIN
		SS←SEG[G+1];
		IF NULSTR(SS) THEN BEGIN G←G+1; GO L2  END; comment  ↑↑↑ ;
		IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
		    BEGIN
		    G←G+1;
		    CTRL(SS[3 FOR 1]);
		    END ELSE CTRL(THISFONT+"0");
		END ELSE CTRL(THISFONT+"0")
	    END
	ELSE ENDC
	  IFC SAILXGP THENC
	    IF XCRIBL THEN
		CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
	ELSE IF F = "_" THEN
		BEGIN
		UNDERLINE ← CHAR;
		IFC SAILVER THENC
			IF XCRIBL THEN CTRL(ESCAPE1&'46);
		ENDC
		IFC ITSVER PJ 8/23/74 ; THENC
			IF XCRIBL THEN BEGIN CTRL(ESCAPE1&'46); CTRL(ESCAPE1&'46) END;
		ENDC
		END
	ELSE IF F = "≡" THEN
		BEGIN "END UNDERLINED TEXT"
		IFC SAILVER THENC
		IF DEVICE = MIC  AND BAR TES 10/22/73;  THEN UNDERSCORE(CHAR) ;
		ENDC
		UNDERLINE ← -1 ;
		IFC SAILVER THENC
		    IF XCRIBL  AND BAR TES 10/22/73;  THEN
			 CTRL(ESCAPE1&'47&3); TES AND REG 11/19/73 ;
		ENDC
		IFC ITSVER THENC PJ 8/23/74 ;
		    IF XCRIBL AND BAR THEN BEGIN CTRL(ESCAPE1&'47&3); CTRL(ESCAPE1&'47&4) END;
		ENDC
		END "END UNDERLINED TEXT"
	ELSE IF F="-" THEN
		BEGIN
		F ← CVD(S[3 TO ∞]) ;
		IF DEVICE=MIC THEN
			IFC SAILVER THENC
				CTRL(DOLSPCS(F))
			ENDC
			IFC PARCVER THENC
			PARCLEFT
			ENDC
		ELSE CHAR←CHAR-F MAX 0
		END
	ELSE IF F="*" THEN CHAR ← 0 MAX LASC[LINE] comment not always correct! ;
	ELSE IF F="+" THEN
		BEGIN F ← CVD(S[3 TO ∞]) ;
		IFC SAILVER THENC
		IF DEVICE=MIC THEN CTRL(DORSPCS(F)) ELSE
		ENDC
		IFC PARCVER THENC
		PARCRIGHT
		ENDC
		IF XCRIBL THEN CTRL(VARBLANK(F))
		ELSE CHAR←CHAR+F MIN IMC
		END
	ELSE IF F="=" THEN
		BEGIN "TAB"
		F ← CVD(S[3 TO ∞]) ;
		IF NOT RASTER THEN F ← (F MAX 0) + LEFTCH - 1 MIN IMC ; TES 8/17/74 FIX BUG ;
		IF XCRIBL THEN XGPTAB(F)
		ELSE IF DEVICE NEQ MIC THEN CHAR ← F
		IFC SAILVER THENC
		ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
		ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
		ENDC
		IFC PARCVER THENC PARCTAB ENDC
		END "TAB"
	ELSE IF F = "π" THEN
		BEGIN TES 11/29/73 REWROTE ; TES 11/4/74 ADDED SPECIAL ;
		BOOLEAN SPECIAL ;
		IFC CMUXGP THENC
		    IF UNDERLINE GEQ 0 AND BAR THEN CTRL(RUBOUT&'35) ;
		ENDC TES 12/13/73 ;
		SPECIAL ← S[3 FOR 1] = 63 ;
		SS ← UNMASH(S[(IF SPECIAL THEN 4 ELSE 3) TO ∞]) ;
		IFC PARCVER THENC
		IF XCRIBL THEN SS←CTLQ&SS ;
		IF MICRO THEN PARCPICHAR
		ELSE
		ENDC
			BEGIN
			F ← LENGTH(SS)-1 ; CHAR ← 0 MAX APPD(SS)-F ;
			LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + F ;
			IF UNDERLINE GEQ 0 AND BAR  AND DEVICE NEQ MIC 
			   IFC SAILXGP THENC  AND NOT XCRIBL  ENDC
				THEN CTRL(IFC PARCVER THENC '10& ENDC BAR) ; TES 12/13/73;
			END ;
		END
	ELSE IF F = "←" THEN BEGIN END
	ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
	ELSE IF F='35 THEN COMMENT OVERSTRIKE NEXT CHAR OVER LAST ;
		BEGIN "OVERSTRIKE"
    IFC CMUXGP THENC
		INTEGER Q;
		Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
		LASC[L]←LASC[L]-1;  CHAR ← 0 MAX CHAR-1;
		CTRL(RUBOUT&'35); CHAR ← 0 MAX APPD(Q);
    ENDC
    IFC SAILXGP THENC WARN("Overstrike unimplemented") ENDC
    IFC PARCVER THENC
	PARCOVLY
    ENDC
		END
	ELSE IF F=RUBOUT THEN IF NOT XCRIBL THEN CHAR←APPD(SP) ELSE
		BEGIN
		CHAR ← 0 MAX APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
		END
	ELSE IMPOSSIBLE("0"&CVOS(F)&" Control Character") ;

comment 2 ... ALTMODE -- word break ;
	IF SHORTM AND G > FSTBRK THEN
		IFC SAILVER THENC IF DEVICE = MIC THEN CHANGESPACING ELSE  ENDC
			BEGIN "SPREAD"
			TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
			IF RASTER THEN
				BEGIN "DOVSB"
				F ← ((TERMX-TERM) MIN SHORTM) ;
				IFC PARCVER THENC IF MICRO THEN PARCJUST ELSE ENDC
				CTRL(VARBLANK(F)) ;
				SHORTM← SHORTM-F
				END "DOVSB"
			ELSE CHAR ← 0 MAX CHAR + TERMX - TERM MIN IMC ;
			TERM ← TERMX ;
			END "SPREAD"
	ELSE IF RASTER THEN
		BEGIN
		CHAR ← 0 MAX APPD(SP);
		END;

comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
END ; COMMENT three cases ;
IFC SAILVER THENC IF CHORIZ NEQ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ; ENDC
IFC SAILXGP THENC
    IF XCRIBL AND UNDERLINE GEQ 0 THEN
	CTRL(ESCAPE1&'47&BASELINE);
ENDC
BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
IFC PARCVER THENC PARCLOSE ENDC
END "JUSTIFY" ;
comment 5 ... LF ; BEGIN END ;
END ; comment, by BRC ;
END "PIECE"
UNTIL PAGEBRC = LF ;
END "LINE" ;
END "COLUMN" ;
END "AREA" ;

IFC PARCVER THENC PARCPAGE ENDC

BEGIN "FINPAGE"
FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;

F ← 120 - (IMC MAX 78) ;

FOR N ← 1 THRU LASL DO
BEGIN "LIST LINE"

L ← N ;
IF DEBUG AND LENGTH(S←SRCREF[L])>F AND DEVICE=LPT THEN
	S←S[1 TO F] ;
NEEDCR ← FALSE ;

DO BEGIN "PART LINE"
IF CHAR ← LASC[L] THEN
	BEGIN "NONBLANK"
	IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE)
	ELSE NEEDCR ← TRUE ; TES 11/1/73;
	OUT(LISTCHAN, FIXUP(IMG[L][1 TO CHAR+FAKE[L]])) ;
	IFC CMUVER THENC	RKJ: 26-SEP-74 - KLUDGE;
	  IF XCRIBL AND FIRST!OUTPUT THEN
	    BEGIN
	    FIRST!OUTPUT←FALSE;
	    DUMMY←CHNCDB(LISTCHAN);
	    START!CODE
	      MOVE 1,DUMMY; HLRZ 1,2(1); MOVE 2,1(1);
	      MOVEI 3,1; MOVEM 3,1(2);
	    END;
	    END;
	ENDC
	IF DEBUG AND L=N AND FULSTR(S) THEN OUT(LISTCHAN,
		(IF XCRIBL THEN XTABSTR(LFTMAR+IMC*CHARW+1)
		 ELSE SPS((IMC MAX 80)-CHAR))   RKJ: 1-4-74;
		& S);
	END "NONBLANK" ;
CHAR ← 0 MAX L ; L ← LINK[CHAR] ;
LINK[CHAR] ← LASC[CHAR] ← FAKE[CHAR] ← 0 ;
END "PART LINE" UNTIL L=0 ;
OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;

IF NEEDVERTI AND
	((L ← LEADING[N+1]+RASTVERTI) IFC SAILXGP THENC NEQ ELSEC > ENDC INTRA) THEN
IFC PARCVER THENC
	BEGIN
	OUT(LISTCHAN, ENDLINE) ;
	OUT(LISTCHAN, CTLK&CVS(L-INTRA)&".") ;
	END
ENDC
IFC CMUXGP THENC OUT(LISTCHAN, ENDLINE) ENDC COMMENT *** ;
IFC SAILXGP THENC OUT(LISTCHAN, ESCAPE1&'42&(L+1)) ENDC BH 11/9/74 ;
ELSE
OUT(LISTCHAN, ENDLINE) ;

LEADING[N] ← 0 ; TES 11/4/74 ;

IF DEBUG THEN SRCREF[N] ← NULL ;
END "LIST LINE" ;

FOR N ← LASL+1 THRU PAGEHIGH DO FAKE[N]←LINK[N]←0 ; TES 4/4/74 ;

IFC ITSVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC

IFC PARCVER THENC
OUT(LISTCHAN, ENDPAGE) ;
ENDC

END "FINPAGE" ;

END "PAGE" ;

IF  NOT (PAGEEOF OR PAGEHIGH LEQ 0) THEN DONE ; comment expand IMG ;
RELEASE(ICHAN) ; RELEASE(SCHAN) ;
END "FILE" ;

END "SIZE" UNTIL SEQEOF ;
IFC PARCVER THENC PARCDOC ENDC

IFC SAILVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC

RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
END "INNER BLOCK" ;
BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT ; K!OUT END ; COMMENT ** ** ** ** ** ;

OUTSTR("." & CRLF) ; comment signal terminal that pass two is done ;
IF DELINT="A" OR DELINT="a" THEN
	BEGIN
	OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
	DELINT ← INCHWL ;
	END ;
IF DELINT="Y" OR DELINT="y" THEN
BEGIN "DELETE INTERMEDIATE FILES"
IFC TENEX THENC
SIMPLE PROCEDURE DELVER(STRING FINAME) ;
	BEGIN INTEGER CHN ;
	CHN ← OPENFILE(FINAME&";*", "RO*") ;
	DO DELF(CHN) UNTIL NOT INDEXFILE(CHN) ;
	RELEASE(CHN) ;
	END ;
DELVER(JOBNO & ".PASS2") ;
ENDC
SEQCHAN ← READIN(
	IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
	 FALSE, SEQBRC, SEQEOF) ;
DO INPUT(SEQCHAN, TO!LF!APPD) UNTIL SEQBRC=LF;
IFC TENEX THENC DELVER(IFILENAME & ".LABELS") ; ELSEC
LABCHAN ← READIN("PULABL"&PUIEXT, FALSE, LABBRC, LABEOF) ;
RENAME(LABCHAN, NULL, 0, I) ;
RELEASE(LABCHAN);
ENDC
AWHILE DO
	BEGIN
	PAGEFILE ← SPARAM ;
	IF SEQEOF THEN DONE ;
	IFC TENEX THENC
	DELVER(IFILENAME & OCTEXT & PAGEFILE) ;
	DELVER(IFILENAME & TXTEXT & PAGEFILE) ;
	ELSEC
	IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
	ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
	SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
	RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
	RELEASE(ICHAN);  RELEASE(SCHAN);
	ENDC
	END ;
IFC NOT TENEX THENC RENAME(SEQCHAN, NULL, 0, I) ENDC ;
RELEASE(SEQCHAN) ;
IFC TENEX THENC DELVER(IFILENAME & ".FILES") ; ENDC
END "DELETE INTERMEDIATE FILES"
ELSE IF DELINT NEQ "N" AND DELINT NEQ "n" THEN
	OUTSTR(CRLF&DELINT&"? -- INTERMEDIATE FILES WERE NOT DELETED") ;

IFC SAILVER THENC
IF DEVICE = MIC THEN
	BEGIN "PASS 3"
	INTEGER FCHAN ;
	INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ;  START!CODE MOVE 1, A ; END ;
	INTEGER ARRAY PASSTHREE[0:4] ;
	FCHAN ← WRITEON("$PUB$"&RPGEXT) ;
	OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
	RELEASE(FCHAN) ;
	PASSTHREE[0] ← CVSIX("DSK") ;
	PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
	PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
	OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
	CALL(CORELOC(PASSTHREE), "SWAP") ;
	END "PASS 3" ;
IF XCRIBL THEN LODED("XSPOOL "&LISTFILE&CRLF);
ENDC

IFC CMUVER THENC
RKJ: 26-SEP-74  ALL NEW CODE;
IF XCRIBL AND DOPASS3 THEN
    BEGIN "PASS 3"
	WTMPFILE("PB3",LISTFILE&CR&LF,TRUE);
	RUNPROG("DSK:PUB3[A700PU00]",1);
	START!CODE CALLI 0,'12 END;
    END "PASS 3";
RKJ: NOW CHECK FOR MORE COMMANDS IN THE TMP FILE;
IF RTMPFILE("PUB",S,FALSE,TRUE) THEN
    BEGIN "RERUN"
	RUNPROG("PUB",1);
	START!CODE CALLI 0,'12 END;
    END "RERUN";
ENDC

IFC ISIVER THENC
TES 8-OCT-74  APPROXIMATION TO WHAT ISI NEEDS;
IF XCRIBL AND DOPASS3 THEN
	BEGIN "PASS 3"
	INTEGER J, JOBNO ;
	JOBNO ← CVS(GJINF(J, I, J)) ;
	J ← OPENFILE(JOBNO & ".PASS3", "WT") ;
	OUT(J, LISTFILE & CRLF) ;
	RELEASE(J) ;
	RUNPRG("<SUBSYS>PUB3.SAV", 1, 0) ;
	CALL(0,"EXIT") ;
	END "PASS 3" ;
ENDC
IFC TENEX THENC CALL(1,"EXIT") ; CALL(0,"EXIT"); ELSEC
START!CODE IFC NOT ITSVER THENC CALLI 1,'12; ENDC CALLI 0,'12; END;
ENDC

MAKEBE(WCW, CW) ;

END "VARIABLE BOUND ARRAY BLOCK" ;

END "PUB2" ;